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-- file Parser. Mesa 

-- last modified by Satterthwai te, August 1, 1978 2:50 PM 

DIRECTORY 

lODefs: FROM "iodefs" USING [CR, TAB, WriteChar, WriteDecimal , WriteString] , 
SystemDefs: FROM "systemdefs" 

USING [AllocateHeapNode, AllocateSegment, FreeHeapNode, FreeSegment], 
StreamDefs: FROM "streamdefs" USING [StreamHandle], 
LALRDefs: FROM "lalrdefs" 
USING [ 

ActionEntry, ActionTag, AsstlEntry. LALRTable, Productionlnfo, 
State, Symbol, SymbolRecord, 
endmarker, InitialSymbol , lastntstate], 
PlDefs: FROM "pldefs" 
USING [ 

AssignDescriptors, Atom, ErrorContext , ProcessQueue, ResetScanlndex, 
Scanlnit, ScanReset, TokenValue]; 

Parser: PROGRAM 

IMPORTS lODefs, SystemDefs. PlDefs 

EXPORTS PlDefs SHARES LALRDefs - 
BEGIN -- Mesa parser with error recovery 
OPEN LALRDefs; 

ErrorLimit: CARDINAL - 25; 

InitialState: State « 1; 

FinalState: State » 0; 

Scan: ActionTag = [FALSE, 0]; 

currentState: State; 
inputSymbol, Ihs: Symbol; 
DefaultMarker: Symbol = endmarker+1; 

input: PROCEDURE RETURNS [symbol: SymbolRecord]; 
inputLoc: CARDINAL; 
inputValue: UNSPECIFIED; 

lastSymbol: SymbolRecord; 
NullSymbol : Symbol = 0; 

s: DESCRIPTOR FOR ARRAY OF State; 
1: DESCRIPTOR FOR ARRAY OF CARDINAL; 
v: DESCRIPTOR FOR ARRAY OF UNSPECIFIED; 
top: CARDINAL; 
stackSize: CARDINAL; 

q: DESCRIPTOR FOR ARRAY OF ActionEntry; 
ql: CARDINAL; 
queueSize: CARDINAL; 

lalrTable: POINTER TO LALRTable; 

-- transition tables for terminal input symbols 

tState: DESCRIPTOR FOR ARRAY OF State; 
asstl: DESCRIPTOR FOR ARRAY OF AsstlEntry; 
tSymbol: DESCRIPTOR FOR ARRAY OF Symbol; 
tAction: DESCRIPTOR FOR ARRAY OF ActionEntry; 

-- transition tables for nonterminal input symbols 

nState: DESCRIPTOR FOR ARRAY OF State; 
nLength: DESCRIPTOR FOR ARRAY OF CARDINAL; 
nSymbol: DESCRIPTOR FOR ARRAY OF Symbol; 
nAction: DESCRIPTOR FOR ARRAY OF ActionEntry; 
nDefaults: DESCRIPTOR FOR ARRAY OF ActionEntry; 

-- production information 

prodData: DESCRIPTOR FOR ARRAY OF Productionlnfo; 

-- initialization/termination 

Parselnit: PROCEDURE [stream: StreamDefs. StreamHandle, tablePtr: POINTER TO LALRTable] 
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BEGIN 

lalrTable ^ tablePtr; -- for error reporting 

PlDef s.ScanInit[stream, tablePtr]; 

BEGIN OPEN tablePtr; 
tState ^ DESCRIPTOR[parsetable.tstate]; 
assti ^ DESCRIPT0R[parsetable.asst1]; 
tSymbol ♦- DESCRIPT0R[parsetab1e. tsym] ; 
tAction ^ DESCRIPTOR[parsetable.tact]; 
nState <-DESCRIPT0R[parsetab1e.nstate] ; 
nLength <- DESCRIPTOR[parsetable. nlen]; 
nSymbol ♦- DESCRIPT0R[parsetab1e. nsym] ; 
nAction ♦- DESCRIPT0R[parsetab1e.nact] ; 
nDefauUs ♦- DESCRIPTOR[parsetable. ntdef aul ts]; 
prodOata ^ DESCRIPTOR[parsetable.proddata]; 
END; 

stackSize *- queueSize ♦- 0; ExpandStack[512]; ExpandQueue[256]; 

RETURN 

END; 

InputLoc: PUBLIC PROCEDURE RETURNS [CARDINAL] » 
BEGIN 

RETURN [inputLoc] 
END; 



m m m m 



Main Parsing Procedures * * 



Parse: PUBLIC PROCEDURE [ 

stream: StreamDef s .StreamHandle, 
table: POINTER TO LALRTable] 
RETURNS [complete: BOOLEAN, nErrors: CARDINAL] « 
BEGIN 

i, valid, k, m: CARDINAL; -- stack pointers 

j, jO: CARDINAL; 
t j : ActionEntry; 

Parselnit[stream, table]; input ♦- PlDefs.Atom; 

nErrors ^ 0; complete ♦- TRUE; 

i <- top <- valid <- ; ql *- 0; 

s[0] *- currentState ^ InitialState; lastSymbol .class ^ NullSymbol; 

inputSymbol ^ InitialSymbol ; inputValue *- 0; inputLoc ♦- 0; 

WHILE currentState # FinalState DO 
BEGIN 

jO <- tState[currentState]; 

FOR j IN [jO .. jO + asstl[currentState].tlen) 
DO 
SELECT tSymbol[j] FROM 

inputSymbol, Def aul tMarker => EXIT; 
ENDCASE; 
REPEAT 

FINISHED »> GO TO SyntaxError; 
ENDLOOP; 

tj <- tAction[j]; 

IF '-tj . rtag. reduce — scan or scan reduce entry 
THEN 
BEGIN 
IF ql > 
THEN 
BEGIN 

FOR k IN (valid.. i] DO s[k] ^ s[top+(k-val id)] ENDLOOP; 
PlDef s ,ProcessQueue[qI , top]; ql +- 0; 
END; 
IF (top <- valid <- i <- i+1) >= stackSize THEN ExpandStack[256] ; 
lastSymbol .class ^ inputSymbol; v[i] <- inputValue; l[i] ^ inputLoc; 
[inputSymbol, inputValue, inputLoc] <- input[]. symbol ; 
END; 

WHILE tj.rtag tf Scan 
DO 

IF ql >« queueSize THEN ExpandQueue[256]; 
qCql] *- tj; ql - ql + 1; 
i <- i-tj.rtag.plength; 
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currentState ^ s[IF i > valid THEN top+( i-val id) ELSE (valid <- i)]; 
Ihs ♦- prodData[tj. transition]. Ihs; 
BEGIN 

IF currentState <■ lastntstate 
THEN 

BEGIN j <- nState[currentStat8]; 
FOR j IN [j. . j+nLength[currentState]) 
DO 
IF Ihs « nSymbo1[j] THEN 

BEGIN tj *- nActionCJ]; GO TO nfound END; 
ENDLOOP; 
END; 
tj <- nDefauns[1hs]; 
EXITS 

nfound «> NULL; 
END; 
i *- i+1; 
ENDLOOP; 
IF (m ♦- top+{i-va1id)) >= stackSize THEN ExpandStack[256]; 
s[m] ♦- currentState *- tj .transition; 
EXITS 

SyntaxError »> 
BEGIN 

lastSymbol .value ^ v[top]; lastSymbol . index ♦- l[top]; 
top <- top - 1; 

complete ^ SyntaxError[(nErrors<-nErrors+l)>ErrorLimit] ; 
i <r valid <- top; ql +- 0; lastSymbol . class <- NullSymbol; 
currentState <- s[i]; 

[inputSymbol , inputValue, inputLoc] ♦- input[] .symbol ; 
IF -complete THEN EXIT 
END; 
END; 
ENDLOOP; 

PlDef s.ProcessQueue[qI , top]; 

EraseQueue[] ; EraseStack[] ; 

nErrors ^ nErrors + PlDef s .ScanReset[]; 

RETURN [complete, nErrors] 

END; 

ExpandStack: PROCEDURE [delta: CARDINAL] » 
BEGIN OPEN SystemDefs; 
i: CARDINAL; 

newS: DESCRIPTOR FOR ARRAY OF State; 
newL: DESCRIPTOR FOR ARRAY OF CARDINAL; 
newV: DESCRIPTOR FOR ARRAY OF UNSPECIFIED; 
newSize: CARDINAL = stackSize + delta; 

news ♦- DESCRIPTOR[AllocateSegment[newSize*SIZE[State]], newSize]; 
newL *- DESCRIPTOR[AnocateSegment[newSize*SIZE[CARDINAL]], newSize]; 
newV *- DESCRIPTOR[AllocateSegment[newSize*SIZE[UNSPECIFIED]]. newSize]; 
FOR i IN [0. .StackSize) 

DO newS[i] *- s[i]: newL[i] <-,l[i]; newV[i] <- v[i] ENDLOOP; 
EraseStack[] ; 

s ♦- newS; 1 ^ newL; v <- newV; stackSize *- newSize; 
PlDef s . AssignDescriptors[qd : q, vd:v, ld:l, pd:prodData]; 
RETURN 
END; 

EraseStack: PROCEDURE « 
BEGIN 

IF StackSize # 
THEN 

BEGIN OPEN SystemDefs; 

FreeSegment[BASE[v]]; FreeSegment[BASE[l]] ; FreeSegment[BASE[s]] ; 
END; 
RETURN 
END; 

ExpandQueue: PROCEDURE [delta: CARDINAL] « 
BEGIN OPEN SystemDefs; 
i: CARDINAL; 

newQ: DESCRIPTOR FOR ARRAY OF ActionEntry; 
newSize: CARDINAL * queueSize + delta; 

newQ *- DESCRIPTOR[AllocateSegment[newSize*SIZE[ActionEntry]], newSize]; 
FOR i IN [0. .queueSize) DO newQ[i] ^ q[i] ENDLOOP; 
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EraseQueue[]; 

q <- newQ; queueSize ♦- newSize; 

PlDefs.AssignDescriptors[qd:q, vd:v, 1d:1, pd :prodData]; 

RETURN 

END; 

EraseQueue: PROCEDURE ■ 
BEGIN 

IF queueSize ff THEN SystemDef s. FreeSegment[BASE[q]]; 
RETURN 
END; 



.. « * « « Eppor Recovery Section ♦**♦-- 

-- parameters of error recovery 

MinScanLimit: CARDINAL « 4; 

MaxScanLimit: CARDINAL =» 12; 

InsertLimit: CARDINAL « 2; 

DiscardLimit: CARDINAL « 10; 

TreeSize; CARDINAL « 256; 

CheckSize: CARDINAL = MaxScanLimit+InsertLimit+2; 

-- debugging 

ParserlD: PUBLIC PROCEDURE RETURNS [STRING] » 
BEGIN 

RETURN ["Standard 4.0"] 
END; 

track: BOOLEAN = FALSE; 

DisplayNode: PROCEDURE [n: Nodelndex] « 
BEGIN OPEN lODefs; 
IF track THEN 

BEGIN 

WriteString[" : :new node::"L]; 

WriteChar[TAB]; Wr iteDecimal[n]; 
• WriteChar[TAB]; WriteDecimal [tree[n] .father]; 

WriteChar[TAB]; Wr i teDecimal [tree[n] . last] ; WriteChar[TAB]; 

WriteDecima1[tree[n]. state]: WriteChar[TAB] ; TypeSym[tree[n] .symbol]; 

WriteChar[CR]; 

END; 
RETURN 
END; 

-- tree management 

Nodelndex: TYPE = CARDINAL [0. .TreeSize) ; 
Nulllndex: Nodelndex « 0; 

StackNode: TYPE = RECORD[ 
father: Nodelndex, 
last: Nodelndex, 
state: State, 
symbol : Symbol , 
aLeaf, bLeaf: BOOLEAN, 
link: Nodelndex]; 

tree: DESCRIPTOR FOR ARRAY OF StackNode; 
nextNode: Nodelndex; 
maxNode: Nodelndex; 
treeLimit: CARDINAL; 
TreeFull: SIGNAL » CODE; 

Allocate: PROCEDURE [parent, pred: Nodelndex, terminal: Symbol, stateNo: State] 
RETURNS [index: Nodelndex] ■ 
BEGIN 

IF (index <- nextNode) >« treeLimit THEN SIGNAL TreeFull; 
maxNode <- MAX[index, maxNode]; 
tree[index] <- StackNode[ 
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father: parent, 

last: pred, 

state: stateNo, 

symbol : terminal , 

aLeaf: FALSE. 

bLeaf: FALSE. 

link: Nul llndex]; 
nextNode <- nextNode+1; RETURN 
END; 

HashSize: INTEGER « 266; -- should depend on state count 
hashTable: DESCRIPTOR FOR ARRAY OF Nodelndex; 

ParsingMode: TYPE « {ATree. BTree, Checking}; 
parseMode: ParsingMode; 

LinkHash: PROCEDURE [n: Nodelndex] « 
BEGIN 

htlndex: [0. .HashSize) = tree[n] . state MOD HashSize; 
tree[n].link ♦- hashTable[htIndex] ; hashTable[htIndex] ^ n; RETURN 
END; 

ExistingConfiguration: PROCEDURE [stack: StackRep] RETURNS [Nodelndex] ■ 
BEGIN 

n, nl, n2: Nodelndex; 
si. s2: State; 
htlndex: [0. .HashSize); 
aTree: BOOLEAN; 
SELECT parseMode FROM 
ATree => aTree <- TRUE; 
BTree => aTree <- FALSE; 
ENDCASE => RETURN [Nulllndex]; 
htlndex <- stack, extension MOD HashSize; 

FOR n ^ hashTable[htIndex]. tree[n].link UNTIL n = Nulllndex 
DO 

IF (IF aTree THEN tree[n] . aLeaf ELSE tree[n]. bLeaf ) THEN 
BEGIN 

si *- stack. extension; s2 ^ tree[n] .state; 
nl ♦- stack. leaf; n2 <- tree[n]. father ; 
DO 

IF si # s2 THEN EXIT; 
IF nl » n2 THEN RETURN [n]; 
si <- tree[nl]. state; s2 ^ tree[n2]. state; 
nl ♦- tree[nl]. father ; n2 <- tree[n2].f ather ; 
ENDLOOP; 
END; 
ENDLOOP; 
RETURN [Nulllndex] 
END; 

FindNode: PROCEDURE [parent, pred: Nodelndex, stateNo: State] RETURNS [index: Nodelndex] « 
BEGIN 

index <- ExistingConf iguration[[leaf :parent. extension: stateNo]]; 
IF index = Nulllndex 
THEN 
BEGIN 

index ♦- Al locate[parent , pred, 0. stateNo]; 
SELECT parseMode FROM 

ATree => BEGIN tree[index] . aLeaf <- TRUE; LinkHash[index] END; 
BTree »> BEGIN tree[index] .bLeaf <- TRUE; LinkHash[index] END; 
ENDCASE «> NULL; 
END; 
RETURN 
END; 

-- parsing simulation 

NullState: State « LAST[State]; 

StackRep: TYPE « RECORD[ 
leaf: Nodelndex, 
extension: State]; 
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NTEntry: PROCEDURE [state: State, Ihs: Symbol] RETURNS [ActionEntry] - 
BEGIN 

j: CARDINAL; 
IF state <- lastntstate THEN 

BEGIN 

j ^ nState[state]; 

FOR j IN [j..J+nLength[state]) 

DO IF Ihs » nSymbol[j] THEN RETURN [nAction[j]] ENDLOOP; 

END; 
RETURN [nDefauns[1hs]] 
END; 

ActOnStack: PROCEDURE [stack: StackRep, action: ActionEntry, nScanned: [0..1]] 
RETURNS [StackRep] - 
BEGIN 

currentNode, thread: Nodelndex; 
currentState: State; 
count: CARDINAL; 

currentNode ^ thread <- stack. leaf; count *- nScanned; 
IF stack. extension « NullState 

THEN currentState ♦- tree[currentNode]. state 

ELSE BEGIN currentState *- stack. extension; count ^ count + 1 END; 
UNTIL action. rtag = Scan 
DO 

IF count > action. rtag. plength -- can be one greater 
THEN 
BEGIN 

currentNode ♦- FindNode[currentNode, thread, currentState]; 
count <- count - 1; 
END; 
UNTIL count - action. rtag . plength 
DO 

currentNode <- tree[currentNode]. father; count *■ count + 1; 
ENDLOOP; 
currentState ♦- tree[currentNode]. state; count ♦• 1; 
action <- NTEntry[currentState, prodData[action. transition]. Ihs] ; 
ENDLOOP; 
IF count > 1 

THEN currentNode ♦- FindNode[currentNode, thread, currentState]; 
stack. leaf ^ currentNode; stack. extension <- action. transition; 
RETURN [stack] 
END; 

ParseStep: PROCEDURE [stack: StackRep, input: Symbol] RETURNS [StackRep] » 
BEGIN 

currentState: State; 
j, jO: CARDINAL; 
tj: ActionEntry; 
count: [0. .1]; 
scanned: BOOLEAN ♦- FALSE; 

currentState «- IF stack. extension = NullState 
THEN tree[stack. leaf]. state 
ELSE stack. extension; 
WHILE -scanned 
DO 

jO <- tState[currentState]; 
FOR J IN [jO. . jO+asstl[currentState].tlen) 
DO 
SELECT tSymbol[j] FROM 

input, Defaul tMarker => EXIT; 
ENDCASE; 
REPEAT 

FINISHED -> RETURN [[Nulllndex, NullState]]; 
ENDLOOP; 
tj *- tAction[J]; 
IF ~tj . rtag. reduce 

THEN -- shift or shift reduce 

BEGIN count ♦- 1; scanned <- TRUE END 
ELSE count ♦- 0; 
stack ^ ActOnStack[stack, tj, count]; 
currentState ^ stack. extension; 
ENDLOOP; 
RETURN [stack] 
END; 
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-- text buffer management 

newText: ARRAY [0 .. 1+InsertLimit) OF Symbol Record; 
insertCount: CARDINAL; 

BufferSize: CARDINAL ■ 1 + DiscardLimit + (MaxScanLimit+InsertLimit) ; 
sourceText: ARRAY [0 .. BufferSize) OF SymbolRecord; 
scanBase, scanLimit: CARDINAL; 



Advance: PROCEDURE - 
BEGIN 

sourceText[scanLimit] ♦- input[]; scanLimit <- scanLimit + 1; 
RETURN 
END; 

Discard: PROCEDURE ■ 
BEGIN 
IF track THEN 

BEGIN OPEN lODefs; 

WriteString[": :discarding symbol -- "L]; 

TypeSym[ sourceText [scanBase] .c1 ass]; WriteChar[CR] ; 

END; 
scanBase ^ scanBase+1; 
RETURN 
END; 

UnDiscard: PROCEDURE = 
BEGIN 

scanBase ♦■ scanBase-1; 
IF track THEN 

BEGIN OPEN lODefs; 

WriteString[" : :recovering symbol -~ "L]; 

TypeSym[ sourceText [scanBase], class]; WriteChar[CR]; 

END; 
RETURN 
END; 

Recoverlnput: PROCEDURE RETURNS [sym: SymbolRecord] « 
BEGIN 

IF insertCount <« InsertLimit 
THEN 

BEGIN sym *- newText[insertCount]; 
insertCount ^ insertCount+l; 
END 
ELSE 

BEGIN sym ^ sourceText[scanBase] ; 

IF (scanBase <- scanBase+l) = scanLimit THEN input ♦- PlDefs.Atom; 
END; 
RETURN 
END; 



-- acceptance checking 

best: RECORD [ 

nAccepted: CARDINAL, 
nPassed: [0..1], 
node: Nodelndex, 
mode: ParsingMode, 
nDiscards: CARDINAL]; 

RightScan: PROCEDURE [node: Nodelndex] RETURNS [stop: BOOLEAN] « 
BEGIN 

i: CARDINAL; 
stack: StackRep; 
state: State; 
nAccepted: CARDINAL; 
savedNextNode: Nodelndex = nextNode; 
savedMode: ParsingMode « parseMode; 
savedLimit: CARDINAL « treeLimit; 
parseModo <- Checking; treeLimit <- LENGTH[tree]; 
nAccepted *- 0; 

state «- tree[node] .state; stack <- [leaf:node, extension:NullState]; 
FOR i IN [scanBase .. scanLimit) 
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DO 

IF state ■ FinalState 
THEN 
BEGIN 

nAccepted ♦- IF (sourceText[i] .class " endmarker) 
THEN scanLimit-scanBase 
ELSE 0; 
EXIT 
END; 
stack *- ParseStep[stack, sourceText[i]. class] ; 
IF stack. leaf = Nulllndex THEN EXIT; 
nAccepted ♦- nAccepted + l; state ^ stack. extension; 
ENDLOOP; 
nextNode ♦- savedNextNode; treeLimit <- savedLimit; 
SELECT (parseMode <- savedMode) FROM 
ATree "> 

IF nAccepted + 1 > best. nAccepted + best.nPassed 

THEN best ♦- [nAccepted, 1, node, ATree, scanBase-1]; 
BTree »> 

IF nAccepted > best. nAccepted + best.nPassed 

THEN best <- [nAccepted, 0, node, BTree, scanBase]; 
ENDCASE; 
RETURN [nAccepted >= MaxScanLimit] 
END; 

-- strategy management 

Row/Record: TYPE = RECORD [ 
index, limit: CARDINAL, 
stack: StackRep, 
next: RowHandlej; 

RowHandle: TYPE = POINTER TO RowRecord; 

NextRow: PROCEDURE [list: RowHandle] RETURNS [row: RowHandle] « 
BEGIN 

r: RowHandle; 
s, t: Symbol; 
row ^ NIL; 

FOR r <~ list, r.next UNTIL r = NIL 
DO 

IF r . index < r. 1 imit 
THEN 

BEGIN s <r tSymbol[r. index]; 

IF row = NIL OR s < t THEN BEGIN row ♦- r; t ♦- s END; 
END; 
ENDLOOP; 
RETURN 
END; 

FreeRowList: PROCEDURE [list: RowHandle] « 
BEGIN 

r, next: RowHandle; 
FOR r <- list, next UNTIL r « NIL 

DO next *- r.next; SystemDef s . FreeHeapNode[r] ENDLOOP; 
RETURN 
END; 

Position: TYPE « {after, before}; 
Length: TYPE = CARDINAL [0 . . InsertLimit] ; 

levelStart, levelEnd: ARRAY Position OF ARRAY Length OF Nodelndex; 

AddLeaf: PROCEDURE [stack: StackRep, s: Symbol, thread: Nodelndex] RETURNS [stop: BOOLEAN] 
BEGIN 

newLeaf: Nodelndex; 
saveNextNode: Nodelndex « nextNode; 
stack ♦- ParseStep[stack, s]; 

IF stack. leaf « Nulllndex OR ExistingConf iguration[stack] # Nulllndex 
THEN BEGIN nextNode ♦- saveNextNode; stop ^ FALSE END 
ELSE 
BEGIN 
newLeaf <- Anocate[stack. leaf , thread, s, stack. extension]; 
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SELECT parseMode FROM 

ATree «> tree[newLeaf ] .aLeaf ♦■ TRUE; 

BTree «> tree[newLeaf ] .bLeaf ^ TRUE; 

ENDCASE »> ERROR; 
LinkHash[newLeaf]; 
IF track THEN Displ ayNode[newL0af ] ; 
stop ♦- RightScan[newLeaf ]; 
END; 
RETURN 
END; 

Grow/Tree: PROCEDURE [p: Position,' n: Length] RETURNS [stop: BOOLEAN] - 
BEGIN 

i: Nodelndex; 
j, jLimit: CARDINAL; 
stack: StackRep; 
state: State; 
rowList, r: RowHandle; 
s: Symbol; 
IF track THEN 

BEGIN OPEN lODefs; 

WriteString[": :generating length -- "L]; Wri teDecimal [n]; 
WriteChar[IF p = before THEN 'B ELSE 'A]; WriteCharCCR] ; 
END; 
rowList ^ NIL; 

FOR i IN [levelStart[p][n-l] .. levelEnd[p][n-l]) 
DO 

IF tree[i]. symbol ^ OR n « 1 
THEN 
BEGIN 

ENABLE UNWIND => FreeRowLi st[rowList] ; 
rowList ^ NIL; 

stack <- [leaf:i, extension:NullState]; state ^ treeCi]. state; 
DO 

j ♦- tState[state]; jLimit +■ j + asstl[state] . tlen; 
s <- tSymbol[jLimit-l]; 

r <- SystemDefs.AnocateHeapNode[SIZE[RowRecord]]; 
rt <r RowRecord[index: J , 1 imit: jLimit , stack:stack, next:rowList]; 
rowList ^ r; 

IF s j^ DefaultMarker THEN EXIT; 
r. 1 imit <- r. 1 imit - 1; 

stack <- ActOnStack[stack, tAction[jLimit-l], 0]; 
state ♦- stack. extension; 
ENDLOOP; 
UNTIL (r <- NextRow[rowList]) « NIL 
DO 

IF AddLeaf[r. stack. tSymbol[r, index] . i] THEN GO TO found; 
r. index ♦- r. index + 1; 
ENDLOOP; 
END; 
REPEAT 

found => stop ♦- TRUE; 
FINISHED => stop ^ FALSE; 
ENDLOOP; 
FreeRowList[rowList]; rowList ♦- NIL; RETURN 
END; 

CheckTree: PROCEDURE [p: Position, n: Length] RETURNS [stop: BOOLEAN] « 
BEGIN 

i: Nodelndex; 
IF track THEN 

BEGIN OPEN lODefs; 

WriteString[" :: checking length — "L]; WriteDecimal[n]; 

WriteChar[IF p = before THEN 'B ELSE 'A]; Wri teChar[CR] ; 

END; 
FOR i IN [levelStart[p][n] .. levelEnd[p][n]) 

DO 

ENABLE TreeFull «> CONTINUE; 

IF RightScan[i] THEN GO TO found; 

REPEAT 

found «> stop <- TRUE; 
FINISHED «> stop <- FALSE; 

ENDLOOP; 
RETURN 
END; 
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Accept: PROCEDURE - 
BEGIN 

j: CARDINAL; 
p: Nodelndex; 
s: Symbol ; 

discardBase: CARDINAL « best .nPassed ; 
insertCount ^ 1+InsertLimit ; 
FOR p *- best. node, tree[p].last WHILE p > rTop 
DO 

IF (s <- tree[p]. symbol) ff THEN 
BEGIN 

insertCount ^ insertCount-1; 

newText[insertCount] ^ Symbo1Record[s, PlDef s .TokenVa1ue[s] , inputLoc]; 
END; 
ENDLOOP; 
scanBase ♦- discardBase; 
IF best.nDiscards ^ 
THEN 

BEGIN OPEN lODefs; 
WriteString["Text deleted is: "L]; 
FOR j IN [1 .. best.nDiscards] 
DO 

TypeSym[sourceText[scanBase]. class]; scanBase ^ scanBase + 1; 
ENDLOOP; 
END; 
IF insertCount <» InsertLimit 
THEN 

BEGIN OPEN lODefs; 

IF scanBase # discardBase THEN Wri t8Char[CR]; 

WriteString["Text inserted is: "L]; 

FOR j IN [insertCount .. InsertLimit] 

DO TypeSym[newText[j]. class] ENDLOOP; 
END; 
IF discardBase « 1 
THEN 
BEGIN 

insertCount ♦- insertCount-1 ; newText[insertCount] ^ sourceText[0]; 
END; 
IF scanBase + best .nAccepted < scanLimit 

THEN PlDef s . Re setScanIndex[sourceText[scanBase+b est. nAccepted]. index]; 
scanLimit ♦- scanBase + best .nAccepted; 
input <- Recoverlnput; 
- WriteChar[CR]; 
RETURN 
END; 

TypeSym: PROCEDURE [sym: Symbol] » 
BEGIN 

OPEN lODefs, lalrTable.scantable; 
i: CARDINAL; 

vocab: STRING = LOOPHOLE[@vocabbody , STRING]; 
WriteChar[' ]; 
IF sym ~IN [1, .endmarker) 
THEN WriteDecimal[sym] 
ELSE 

FOR i IN [vocabindex[sym-l] . . vocabindex[sym]) 
DO WriteChar[vocab[i]] ENDLOOP; 
RETURN 
END; 

-stack node indices 
rTop: Nodelndex; 

Recover: PROCEDURE ■ 
BEGIN 

ModeMap: ARRAY Position OF ParsingMode = [ATree, BTree]; 
i: CARDINAL; 
place: Position; 
level : Length; 

inserts, discards: CARDINAL; 
stack: StackRep; 
threshold: CARDINAL; 
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treeLimit ^ LENGTH[tree] - CheckSize; 

FOR i IN [0 .. HashSize) DO hashTable[i] ♦- Nulllndex ENDLOOP; 

rTop ♦- Nulllndex; nextNode ♦- maxNode ^ 1; 

best . nAccepted ^ 0; best.nPassed ^ 1; best. mode ^ ATree; 

sourceText[0] <- lastSymbol; 

sourceText[l] *• SymbolRecord[inputSymbol , inputValue, inputLoc]; 

scanBase ♦- 1; scanLimit ^ 2; 

THROUGH [1 .. MaxScanLimit) DO Advance[] ENDLOOP; 

FOR i IN [0 .. top) 

DO 

rTop ♦- Anocate[rTop, rTop, 0, s[i]]; 

IF track THEN DisplayNodeCrTop] ; 

ENDLOOP; 
parseMode <- BTree; 

levelStart[before][0] ^ rTop <- FindNode[rTop. rTop, s[top]]; 
tree[rTop].bLeaf *- TRUE; 
levelEnd[before][0] ^ nextNode; 
parseMode ^ ATree; 

stack <- ParseStep[[leaf :rTop , extension:NunState] , lastSymbol . class]; 
rTop <- FindNode[stack.leaf , rTop, stack. extension]; 
tree[rTop]. symbol ^ lastSymbol .cl ass; 
tree[rTop] . aLeaf ♦- tree[rTop] .bLeaf <- TRUE; 
levelStart[after][0] *- rTop; levelEnd[after][0] <- nextNode; 
IF track THEN DisplayNode[rTop] ; 

FOR level IN [1 .. LAST[Length]] 
DO 

FOR place IN Position 
DO 

parseMode ^ ModeMap[place]; 
IF place = before THEN UnDiscard[]; 
~~ try simple insertion (inserts»level ) 
levelStart[place][level ] ♦- nextNode; 

IF GrowTree[place. level ITreeFull => CONTINUE] THEN GO TO found; 
levelEnd[place][level ] *- nextNode; 
-- try discards followed by or more insertions 
FOR discards IN [1 . . level) 
DO 

Discard[]; 

IF CheckTree[place, level] THEN GO TO found; 
ENDLOOP; 
Discard[] ; 

IF place = after THEN Advance[]; 
FOR inserts IN [0 . . level] 
DO 

IF CheckTree[place, inserts] THEN GO TO found; 
ENDLOOP; 
-- undo discards at this level 

FOR discards DECREASING IN [1,. level] DO UnDiscardC] ENDLOOP; 
IF place = before THEN Discard[]; 
ENDLOOP; 
REPEAT 

found => NULL; 
FINISHED -> 
BEGIN 

threshold <- (MinScanLimit+MaxScanLimit)/2; 

FOR discards IN [1 . .LAST[Length]] DO DiscardC]; Advance[] ENDLOOP; 
UNTIL scanBase > DiscardLimit 
DO 

IF best. nAccepted >= threshold THEN GO TO found; 
Discard[] ; 

FOR inserts IN Length 
DO 

FOR place IN Position 
DO 

parseMode ♦- ModeMap[place]; 
IF place « before THEN UnDiscard[]; 
IF CheckTree[place, inserts] THEN GO TO found; 
IF place « before THEN Discard[]; 
ENDLOOP; 
ENDLOOP; 
Advance[] ; 

threshold <- IF threshold > MinScanLimit THEN threshold~l ELSE MinScanLimit; 
REPEAT 
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found «> NULL; 
FINISHED ■> 

IF best.nAccepted < MinScanLimit 

THEN BEGIN best. mode ^ ATree; best.nPassed ^ 1 END; 
ENDLOOP; 
END; 
ENDLOOP; 

RETURN 
END; 

SyntaxError: PROCEDURE [abort: BOOLEAN] RETURNS [success: BOOLEAN] » 
BEGIN 
IF abort 
THEN 

BEGIN OPEN lODefs; 

PlDefs.ErrorContext["Syntax Error"L, inputLoc]; 
WriteString[". . . Parse abandoned. "L] ; WriteChar[CR]; 
success ^ FALSE 
END 
ELSE 
BEGIN 

tree <- DESCRIPTOR[SystemDef s. Al locateSegment[TreeSize*SIZE[StackNode]], TreeSize]; 
hashTable ♦- DESCRIPTOR[SystemDef s .AnocateSegment[HashSize*SIZE[NodeIndex]]. HashSize]; 
Recover[ I TreeFull => CONTINUE]; 
SystemDef s . FreeSegment[BASE[hashTab1e]]; 
PlDefs.ErrorCon text ["Syntax Error "L, 

sourceText[IF best .mode=BTree THEN ELSE 1]. index]; 
IF (success ^ best.nAccepted >= MinScanLimit) 
THEN Accept[] 

ELSE lODef s.WriteString["No recovery found. "L]; 
SystemDefs.FreeSegment [BASE [tree]]; 
BEGIN OPEN lODefs; 

WriteString[" ("L]; WriteDecimal [maxNode]; WriteChar[ ' )]; 
WriteChar[CR]; 
END; 
END; 
RETURN 
END; 

END. 



